home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / MENU_UTL / CO39 / SCLPTEXT.PAS < prev    next >
Pascal/Delphi Source File  |  1992-08-10  |  5KB  |  177 lines

  1. {SclpText - Extensions to ObjectWindows Copyright (C) Doug Overmyer 7/1/91}
  2. unit SclpText;
  3. {***********************  Interface     **************************}
  4. interface
  5. uses WinTypes, WinProcs, WinDos, Strings, WObjects;
  6. const
  7.     sr_Recessed     =   1;
  8.   sr_Raised       =   0;
  9. type
  10. PSRect = ^TSRect;
  11. TSRect = object(TWindow)
  12.   W,H:Integer;
  13.     State:Integer;
  14.   constructor Init(AParent:PWindowsObject;AnID:Integer; ATitle:PChar;
  15.       NewX,NewY,NewW,NewH:Integer; NewState:Integer);
  16.   destructor Done;virtual;
  17.   procedure Paint(PaintDC:HDC; var PaintInfo:TPaintStruct);virtual;
  18.   procedure MoveWin(NewX,NewY,NewW,NewH:Integer);
  19. end;
  20.  
  21. type
  22. PSText = ^TSText;
  23. TSText = object(TSRect)
  24.     Text:Array [0..80] of Char;
  25.   DTStyle:Integer;
  26.   DTFont:hfont;
  27.   constructor Init(AParent:PWindowsObject;AnID:Integer; ATitle:PChar;
  28.       NewX,NewY,NewW,NewH:Integer; NewState,NewStyle:Integer);
  29.   destructor Done;virtual;
  30.   procedure Paint(PaintDC:HDC; var PaintInfo:TPaintStruct);virtual;
  31.   procedure SetText(NewText:PChar);virtual;
  32.   procedure SetFont(NewFont:HFont);virtual;
  33. end;
  34.  
  35. {***********************  Implementation          *******************}
  36. implementation
  37.  
  38. {***********************         TSRect         *********************}
  39. constructor TSRect.Init(AParent:PWindowsObject; AnID:Integer;
  40.     ATitle:PChar;    NewX,NewY,NewW,NewH:Integer; NewState:Integer);
  41. begin
  42.     TWindow.Init(AParent,ATitle);
  43.   Attr.Style := ws_Child or ws_visible ;
  44.   Attr.X := NewX;
  45.   Attr.Y := NewY;
  46.   Attr.W := NewW;
  47.   Attr.H := NewH;
  48.   Attr.ID := AnID;
  49.   W := NewW;
  50.   H := NewH;
  51.   if NewState = sr_Recessed then
  52.       State := sr_Recessed
  53.     else
  54.         State := sr_Raised;
  55.  
  56. end;
  57.  
  58. destructor TSRect.Done;
  59. begin
  60.     TWindow.Done;
  61. end;
  62.  
  63. procedure TSRect.Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);
  64. var
  65.   LPts:Array[0..2] of TPoint;
  66.   RPts:Array[0..2] of TPoint;
  67.     ThePen:HPen;
  68.   Pen1:HPen;
  69.   Pen2:HPen;
  70.   TheBrush :HBrush;
  71.   OldBrush :HBrush;
  72.   OldPen:HPen;
  73.   OldBkMode:Integer;
  74.   DRect:TRect;
  75.   Ofs:Integer;
  76. begin
  77.   TheBrush := GetStockObject(ltGray_Brush);    {Draw window background}
  78.   OldBrush := SelectObject(PaintDC,TheBrush);
  79.   Rectangle(PaintDC,0,0,W,H);
  80.   SelectObject(PaintDC,OldBrush);
  81.  
  82.   Ofs := 0;
  83.     LPts[0].x := Ofs;   LPts[0].y := H-Ofs;
  84.     LPts[1].x := Ofs;   LPts[1].y := Ofs;
  85.   LPts[2].x := W-Ofs; LPts[2].y := Ofs;
  86.   RPts[0].x := Ofs;   RPts[0].y := H-Ofs;
  87.     RPts[1].x := W-Ofs; RPts[1].y := H-Ofs;
  88.     RPts[2].x := W-Ofs; RPts[2].y := Ofs;
  89.  
  90.     Pen1 := CreatePen(ps_Solid,1,$00000000);  {Draw a surrounding blk frame}
  91.   OldPen := SelectObject(PaintDC,Pen1);
  92.   PolyLine(PaintDC,LPts,3);
  93.   PolyLine(PaintDC,RPts,3);
  94.   SelectObject(PaintDC,OldPen);
  95.   DeleteObject(Pen1);
  96.  
  97.   Ofs := 1;
  98.     LPts[0].x := Ofs;   LPts[0].y := H-Ofs;
  99.     LPts[1].x := Ofs;   LPts[1].y := Ofs;
  100.   LPts[2].x := W-Ofs; LPts[2].y := Ofs;
  101.   RPts[0].x := Ofs;   RPts[0].y := H-Ofs;
  102.     RPts[1].x := W-Ofs; RPts[1].y := H-Ofs;
  103.     RPts[2].x := W-Ofs; RPts[2].y := Ofs;
  104.   if State = sr_Raised then
  105.       begin
  106.         Pen1 := CreatePen(ps_Solid,1,$00FFFFFF);
  107.     Pen2 := CreatePen(ps_Solid,1,$00808080);
  108.     end
  109.   else
  110.       begin
  111.       Pen1 := CreatePen(ps_Solid,1,$00808080);
  112.         Pen2 := CreatePen(ps_Solid,1,$00FFFFFF);
  113.     end;
  114.  
  115.   OldPen := SelectObject(PaintDC,Pen1);   {Draw the highlights}
  116.   PolyLine(PaintDC,LPts,3);
  117.   SelectObject(PaintDC,Pen2);
  118.   DeleteObject(Pen1);
  119.  
  120.   PolyLine(PaintDC,RPts,3);
  121.   SelectObject(PaintDC,OldPen);
  122.   DeleteObject(Pen2);
  123. end;
  124. procedure TSRect.MoveWin(NewX,NewY,NewW,NewH:Integer);
  125. begin
  126.   W := NewW;
  127.   H := NewH;
  128.   MoveWindow(HWindow,NewX,NewY,NewW,NewH,True);
  129. end;
  130. {************************   TSText   ********************************}
  131. constructor TSText.Init(AParent:PWindowsObject; AnID:Integer;
  132.     ATitle:PChar;    NewX,NewY,NewW,NewH:Integer; NewState,NewStyle:Integer);
  133. begin
  134.     TSRect.Init(AParent,AnID,ATitle,NewX,NewY,NewW,NewH,NewState);
  135.   DTStyle := NewStyle;
  136.   StrCopy(Text,ATitle);
  137.   DTFont := 0;
  138. end;
  139.  
  140. destructor TSText.Done;
  141. begin
  142.     TSRect.Done;
  143. end;
  144.  
  145. procedure TSText.Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);
  146. var
  147.   OldBkMode:Integer;
  148.   DRect:TRect;
  149.   OldFont:hFont;
  150. begin
  151.   TSRect.Paint(PaintDC,PaintInfo);
  152.   OldFont := 0;
  153.   if DTFont <> 0 then
  154.       OldFont := SelectObject(PaintDC,DTFont);
  155.   OldBkMode := SetBkMode(PaintDC,Transparent);  {Draw the text}
  156.   DRect.left := 3;DRect.Top := 2;DRect.right := W-3;DRect.Bottom := H-2;
  157.   DrawText(PaintDC,Text,StrLen(Text),DRect,DTStyle);
  158.   SetBkMode(PaintDC,OldBkMode);
  159.   If OldFont > 0 then
  160.       SelectObject(PaintDC,OldFont);
  161. end;
  162.  
  163. procedure TSText.SetText(NewText:PChar);
  164. var
  165.     DRect:TRect;
  166. begin
  167.     StrCopy(Text,NewText);
  168.   DRect.left := 3;DRect.Top := 2;DRect.right := W-3;DRect.Bottom := H-2;
  169.   InvalidateRect(HWindow,@DRect,false);
  170. end;
  171.  
  172. procedure TSText.SetFont(NewFont:HFont);
  173. begin
  174.     DTFont := NewFont;
  175. end;
  176. end.
  177.